home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload Trio 2 / Shareware Overload Trio Volume 2 (Chestnut CD-ROM).ISO / dir43 / qsrc_dsk.zip / MODEL / ASK.PRG next >
Text File  |  1991-12-17  |  8KB  |  220 lines
  1. *       ╓─────────────────────────────────────────────────────────╖
  2. *       ║                                                         ║
  3. *       ║ 12/17/91               ASK.PRG                 11:01:30 ║
  4. *       ║                                                         ║
  5. *       ╟─────────────────────────────────────────────────────────╢
  6. *       ║                                                         ║
  7. *       ║ Lisa C. Slater and Steven E. Arnott                     ║
  8. *       ║                                                         ║
  9. *       ║ Copyright (c) 1991                                      ║
  10. *       ║ Application developed for _Using FoxPro 2_              ║
  11. *       ║ Que Publishing Corporation                              ║
  12. *       ║ ISBN 0-88022-703-6                                      ║
  13. *       ║                                                         ║
  14. *       ║ Description:                                            ║
  15. *       ║ This program was automatically generated by GENSCRN.    ║
  16. *       ║                                                         ║
  17. *       ╙─────────────────────────────────────────────────────────╜
  18.  
  19.  
  20. *       ╓─────────────────────────────────────────────────────────╖
  21. *       ║                                                         ║
  22. *       ║               ASK Setup Code - SECTION 1                ║
  23. *       ║                                                         ║
  24. *       ╙─────────────────────────────────────────────────────────╜
  25. *
  26.  
  27. #REGION 1
  28. PARAMETERS m.question, m.value,m.valid
  29. novalid = (PARAMETERS() = 2)
  30.  
  31. * this screen is called with its SAY,
  32. * its GET, and any necessary PICTURE for
  33. * the validation of the GET. A dummy GET
  34. * of null length is used in the SCX to
  35. * call the real GET.
  36.  
  37. * m.question can be up to 47 chars -- you
  38. * can adjust this if you make the window bigger.
  39.  
  40. * m.value can be of any TYPE except memo.
  41. * ordinarily you initialize the value before
  42. * calling the ASK.SPR, which helps ASK determine
  43. * the necessary length of the GET, like this:
  44.  
  45. * seekcode = product.prodcode
  46. * DO ASK.SPR WITH "Product to seek:",seekcode,"@! AAA99"
  47.  
  48. * or:
  49.  
  50. * yesno = "NO " && see note one line down
  51. * DO ASK.SPR WITH "Ready now?",yesno,"@M NO, YES"
  52. * (in the @M case the extra space should be used
  53. * if the initial value of m.value is not its
  54. * longest possible value)
  55.  
  56. * if you generate the screen with the non-default
  57. * PRG extension, you can use ASK as a UDF and
  58. * the appropriate new value will be returned;
  59. * in that case you don't initialize it first,
  60. * and you'd call it like this:
  61. * seekcode = ASK("Product to find:",product.prodcode,"@! AAA99")
  62. * bigitem = ASK("Smallest item to mark:",0,"9999")
  63. * This is demonstrated in the Pack procedure of
  64. * WIDGET2.MPR.
  65.  
  66. * m.valid is not required.
  67. * If you want to use FUNCTION as well as
  68. * or instead of PICTURE, just include your
  69. * FUNCTION codes with the @ symbol in m.valid
  70. * as shown above and it will be parsed properly.
  71.  
  72.  
  73. #REGION 0
  74. REGIONAL m.currarea, m.talkstat, m.compstat
  75.  
  76. IF SET("TALK") = "ON"
  77.     SET TALK OFF
  78.     m.talkstat = "ON"
  79. ELSE
  80.     m.talkstat = "OFF"
  81. ENDIF
  82. m.compstat = SET("COMPATIBLE")
  83. SET COMPATIBLE FOXPLUS
  84.  
  85. *       ╓─────────────────────────────────────────────────────────╖
  86. *       ║                                                         ║
  87. *       ║                    Window definitions                   ║
  88. *       ║                                                         ║
  89. *       ╙─────────────────────────────────────────────────────────╜
  90. *
  91.  
  92. IF NOT WEXIST("_q1g0nmphf")
  93.     DEFINE WINDOW _q1g0nmphf ;
  94.         FROM INT((SROW()-7)/2),INT((SCOL()-50)/2) ;
  95.         TO INT((SROW()-7)/2)+6,INT((SCOL()-50)/2)+49 ;
  96.         FLOAT ;
  97.         NOCLOSE ;
  98.         SHADOW ;
  99.         DOUBLE ;
  100.         COLOR SCHEME 5
  101. ENDIF
  102.  
  103.  
  104. *       ╓─────────────────────────────────────────────────────────╖
  105. *       ║                                                         ║
  106. *       ║               ASK Setup Code - SECTION 2                ║
  107. *       ║                                                         ║
  108. *       ╙─────────────────────────────────────────────────────────╜
  109. *
  110.  
  111. #REGION 1
  112. * initialize dummy variable
  113. m.dummy =""
  114.  
  115.  
  116. *       ╓─────────────────────────────────────────────────────────╖
  117. *       ║                                                         ║
  118. *       ║                    ASK Screen Layout                    ║
  119. *       ║                                                         ║
  120. *       ╙─────────────────────────────────────────────────────────╜
  121. *
  122.  
  123. #REGION 1
  124. IF WVISIBLE("_q1g0nmphf")
  125.     ACTIVATE WINDOW _q1g0nmphf SAME
  126. ELSE
  127.     ACTIVATE WINDOW _q1g0nmphf NOSHOW
  128. ENDIF
  129. @ 1,0 SAY padc(m.question,47) ;
  130.     SIZE 1,46 ;
  131.     PICTURE "@I" ;
  132.     COLOR W+/RB   
  133. @ 3,23 GET m.dummy ;
  134.     SIZE 1,1 ;
  135.     DEFAULT " " ;
  136.     WHEN _q1g0nmske()
  137.  
  138. IF NOT WVISIBLE("_q1g0nmphf")
  139.     ACTIVATE WINDOW _q1g0nmphf
  140. ENDIF
  141.  
  142. READ CYCLE
  143.  
  144. RELEASE WINDOW _q1g0nmphf
  145.  
  146. #REGION 0
  147. IF m.talkstat = "ON"
  148.     SET TALK ON
  149. ENDIF
  150. IF m.compstat = "ON"
  151.     SET COMPATIBLE ON
  152. ENDIF
  153.  
  154.  
  155. *       ╓─────────────────────────────────────────────────────────╖
  156. *       ║                                                         ║
  157. *       ║                    ASK Cleanup Code                     ║
  158. *       ║                                                         ║
  159. *       ╙─────────────────────────────────────────────────────────╜
  160. *
  161.  
  162. #REGION 1
  163. * will only be used if the screen is going to be
  164. * generated as a UDF with a PRG extension
  165. RETURN m.value
  166.  
  167. *       ╓─────────────────────────────────────────────────────────╖
  168. *       ║                                                         ║
  169. *       ║ _Q1G0NMSKE           m.dummy WHEN                       ║
  170. *       ║                                                         ║
  171. *       ║ Function Origin:                                        ║
  172. *       ║                                                         ║
  173. *       ║ From Screen:         ASK,     Record Number:    3       ║
  174. *       ║ Variable:            m.dummy                            ║
  175. *       ║ Called By:           WHEN Clause                        ║
  176. *       ║ Object Type:         Field                              ║
  177. *       ║ Snippet Number:      1                                  ║
  178. *       ║                                                         ║
  179. *       ╙─────────────────────────────────────────────────────────╜
  180. *
  181. FUNCTION _q1g0nmske     &&  m.dummy WHEN
  182. #REGION 1
  183. PRIVATE temp, msize, getcol
  184. DO CASE
  185. CASE "@M" $ m.valid
  186.    temp = LEN(m.value)
  187.    * don't trim this one;
  188.    * use the way the sample/initial value is
  189.    * set up (with an extra space if necessary,
  190.    * if the initial value is not the longest one)
  191.    * to format the @M-type GET properly
  192. CASE TYPE("m.value") = "C" AND (! novalid) AND ;
  193.    "@" $ m.valid AND " " $ m.valid
  194.    temp = LEN(m.valid)-AT(" ",m.valid)
  195.    * get rid of the function codes to find the
  196.    * length of the GET
  197. CASE TYPE("m.value") = "C" AND (novalid OR "@" $ m.valid)
  198.    temp = LEN(ALLTRIM(m.value))
  199. CASE TYPE("m.value") = "C"
  200.    temp = LEN(ALLTRIM(m.valid))
  201. CASE TYPE("m.value") = "N"
  202.    temp = IIF(novalid,LEN(ALLTRIM(STR(m.value))),;
  203.                       LEN(m.valid)-AT(" ",m.valid))
  204. CASE TYPE("m.value") = "D"
  205.    temp = IIF(SET("CENTURY") = "ON",10,8)
  206. CASE TYPE("m.value") = "L"
  207.    temp = 1
  208. ENDCASE
  209. getcol = 23-INT(temp/2)
  210. msize = "1,"+ALLTRIM(STR(temp))
  211. IF novalid
  212.    @3,getcol GET m.value SIZE &msize
  213. ELSE
  214.    temp = ALLTRIM(m.valid)
  215.    @3,getcol GET m.value PICTURE (temp) SIZE &msize
  216. ENDIF
  217. READ MODAL
  218. CLEAR READ
  219. RETURN .F.
  220.